home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 72 / applic / lister2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-11-21  |  3.1 KB  |  159 lines
  1. Program LISTER2;
  2.  
  3. Const
  4.      {$I GEMCONST.PAS }
  5.  
  6. Type
  7.      {$I GEMTYPE.PAS }
  8.  
  9. Var
  10.      Trans:Boolean;
  11.      DefPath,FullName:String[255];
  12.      TMarg,BMarg,LMarg,RMarg,PageLen,NChar,NLines:Integer;
  13.      Lst,InFile:Text;
  14.  
  15. {------------------------------------------------------------------------}
  16.  
  17. {$I GEMSUBS.PAS }
  18.  
  19. Procedure Init;
  20.  
  21. Begin
  22. TMarg:=2;
  23. BMarg:=2;
  24. PageLen:=66;
  25. NLines:=PageLen-TMarg-BMarg+1;
  26. LMarg:=4;
  27. RMarg:=80;
  28. NChar:=RMarg-LMarg+1;
  29. DefPath:='A:\*.*';
  30. FullName:='';
  31. Trans:=True;
  32. End;
  33.  
  34. {------------------------------------------------------------------------}
  35.  
  36. Procedure Indent(Var C:Integer);
  37.  
  38. Var
  39.      I:Integer;
  40.  
  41. Begin
  42.      If(LMarg>1)
  43.      Then For I:=2 to LMarg Do
  44.           Write(Lst,' ');
  45. C:=LMarg-1
  46. End;
  47.  
  48. {------------------------------------------------------------------------}
  49.  
  50. Procedure Top(Var L:Integer);
  51.  
  52. Var
  53.      I:Integer;
  54.  
  55. Begin
  56.      If(TMarg>0)
  57.      Then For I:=1 to TMarg Do
  58.           WriteLn(Lst);
  59. L:=L+TMarg;
  60. End;
  61.  
  62. {------------------------------------------------------------------------}
  63.  
  64. Procedure Bottom(Var L:Integer);
  65.  
  66. Var
  67.      I:Integer;
  68.  
  69. Begin
  70.      If(BMarg>0)
  71.      Then For I:=1 to BMarg Do
  72.           WriteLn(Lst);
  73. L:=0;
  74. End;
  75.  
  76. {------------------------------------------------------------------------}
  77.  
  78. Function ChTest(Var Ch:Char):Boolean;
  79.  
  80. Begin
  81.      If Trans
  82.      Then If(Ch>=' ') and (Ch<=Chr(127))
  83.           Then ChTest:=True
  84.           Else ChTest:=False
  85.      Else ChTest:=True
  86. End;
  87.  
  88. {------------------------------------------------------------------------}
  89.  
  90. Procedure FinPage(Var L:Integer);
  91.  
  92. Begin
  93. While L<=NLines Do
  94.      Begin
  95.      WriteLn(Lst);
  96.      L:=L+1;
  97.      End;
  98. Bottom(L);
  99. End;
  100.  
  101. {------------------------------------------------------------------------}
  102.  
  103. Procedure Verbatim;
  104.  
  105. Var
  106.      Ch:Char;
  107.      C,L:Integer;
  108.  
  109. Begin
  110. L:=0;
  111. Top(L);
  112. Indent(C);
  113. While Not EOF(InFile) Do
  114.      Begin
  115.           If(EOLN(InFile)) or (C>=NChar)
  116.           Then Begin
  117.                If(EOLN(InFile)) Then Read(InFile,Ch);
  118.                WriteLn(Lst);
  119.                L:=L+1;
  120.                     If(L<=NLines)
  121.                     Then Indent(C)
  122.                     Else If Not EOF(InFile)
  123.                          Then Begin
  124.                               Bottom(L);
  125.                               Top(L);
  126.                               Indent(C);
  127.                               End;
  128.                End
  129.           Else Begin
  130.                Read(InFile,Ch);
  131.                     If(ChTest(Ch))
  132.                     Then Begin
  133.                          Write(Lst,Ch);
  134.                          C:=C+1;
  135.                          End;
  136.                End;
  137.      End;
  138. FinPage(L);
  139. End;
  140.  
  141. {========================================================================}
  142.  
  143. Begin {Main Program}
  144.      If(Init_Gem>-1)
  145.      Then Begin
  146.           Init_Mouse;
  147.           Set_Mouse(M_Arrow);
  148.           Init;
  149.           Rewrite(Lst,'Lst:');
  150.           While Get_In_File(DefPath,FullName) Do
  151.                Begin
  152.                Reset(InFile,FullName);
  153.                Verbatim;
  154.                Close(InFile);
  155.                Close(Lst);
  156.                End;
  157.           End;
  158. End.
  159.